home *** CD-ROM | disk | FTP | other *** search
/ Complete Linux / Complete Linux.iso / docs / devel / lisp / akcl_lin.z / akcl_lin / c / file.d < prev    next >
Encoding:
Text File  |  1993-03-08  |  42.1 KB  |  2,120 lines
  1. /*
  2. (c) Copyright Taiichi Yuasa and Masami Hagiya, 1984.  All rights reserved.
  3. Copying of this file is authorized to users who have executed the true and
  4. proper "License Agreement for Kyoto Common LISP" with SIGLISP.
  5. */
  6.  
  7. /*
  8.     file.d
  9.     IMPLEMENTATION-DEPENDENT
  10.  
  11.     The specification of printf may be dependent on the C library,
  12.     especially for read-write access, append access, etc.
  13.     The file also contains the code to reclaim the I/O buffer
  14.     by accessing the FILE structure of C.
  15.     It also contains read_fasl_data.
  16. */
  17.  
  18. #define IN_FILE
  19. #include "include.h"
  20.  
  21. #define    kclgetc(FP)        getc(FP)
  22. #define    kclungetc(C, FP)    ungetc(C, FP)
  23. #define    kclfeof(FP)        feof(FP)
  24. #define    kclputc(C, FP)        putc(C, FP)
  25.  
  26.  
  27. #ifdef HAVE_AOUT
  28. #undef ATT
  29. #undef BSD
  30. #define BSD
  31. #include HAVE_AOUT
  32. #endif
  33.  
  34. #ifdef ATT
  35. #include <filehdr.h>
  36. #include <syms.h>
  37. #endif
  38.  
  39. #ifdef E15
  40. #include <a.out.h>
  41. #define exec    bhdr
  42. #define a_text    tsize
  43. #define a_data    dsize
  44. #define a_bss    bsize
  45. #define a_syms    ssize
  46. #define a_trsize    rtsize
  47. #define a_drsize    rdsize
  48. #endif
  49.  
  50. #ifdef HAVE_ELF
  51. #include <elf.h>
  52. #endif
  53.  
  54. static object terminal_io;
  55.  
  56. object Vverbose;
  57. object LSP_string;
  58.  
  59.  
  60. object siVignore_eof_on_terminal_io;
  61.  
  62. bool
  63. feof1(fp)
  64. FILE *fp;
  65. {
  66.     if (!feof(fp))
  67.         return(FALSE);
  68.     if (fp == terminal_io->sm.sm_object0->sm.sm_fp) {
  69.         if (symbol_value(siVignore_eof_on_terminal_io) == Cnil)
  70.             return(TRUE);
  71. #ifdef UNIX
  72.         fp = freopen("/dev/tty", "r", fp);
  73. #endif
  74. #ifdef AOSVS
  75.  
  76. #endif
  77.         if (fp == NULL)
  78.             error("can't reopen the console");
  79.         return(FALSE);
  80.     }
  81.     return(TRUE);
  82. }
  83.  
  84. #undef    feof
  85. #define    feof    feof1
  86.  
  87.  
  88. end_of_stream(strm)
  89. object strm;
  90. {
  91.     FEerror("Unexpected end of ~S.", 1, strm);
  92. }
  93.  
  94. /*
  95.     Input_stream_p(strm) answers
  96.     if stream strm is an input stream or not.
  97.     It does not check if it really is possible to read
  98.     from the stream,
  99.     but only checks the mode of the stream (sm_mode).
  100. */
  101. bool
  102. input_stream_p(strm)
  103. object strm;
  104. {
  105. BEGIN:
  106.     switch (strm->sm.sm_mode) {
  107.     case smm_input:
  108.         return(TRUE);
  109.  
  110.     case smm_output:
  111.         return(FALSE);
  112.  
  113.     case smm_io:
  114.         return(TRUE);
  115.  
  116.     case smm_probe:
  117.         return(FALSE);
  118.  
  119.     case smm_synonym:
  120.         strm = symbol_value(strm->sm.sm_object0);
  121.         if (type_of(strm) != t_stream)
  122.             FEwrong_type_argument(Sstream, strm);
  123.         goto BEGIN;
  124.  
  125.     case smm_broadcast:
  126.         return(FALSE);
  127.  
  128.     case smm_concatenated:
  129.         return(TRUE);
  130.  
  131.     case smm_two_way:
  132.         return(TRUE);
  133.  
  134.     case smm_echo:
  135.         return(TRUE);
  136.  
  137.     case smm_string_input:
  138.         return(TRUE);
  139.  
  140.     case smm_string_output:
  141.         return(FALSE);
  142.  
  143.     default:
  144.         error("illegal stream mode");
  145.     }
  146. }
  147.  
  148. /*
  149.     Output_stream_p(strm) answers
  150.     if stream strm is an output stream.
  151.     It does not check if it really is possible to write
  152.     to the stream,
  153.     but only checks the mode of the stream (sm_mode).
  154. */
  155. bool
  156. output_stream_p(strm)
  157. object strm;
  158. {
  159. BEGIN:
  160.     switch (strm->sm.sm_mode) {
  161.     case smm_input:
  162.         return(FALSE);
  163.  
  164.     case smm_output:
  165.         return(TRUE);
  166.  
  167.     case smm_io:
  168.         return(TRUE);
  169.  
  170.     case smm_probe:
  171.         return(FALSE);
  172.  
  173.     case smm_synonym:
  174.         strm = symbol_value(strm->sm.sm_object0);
  175.         if (type_of(strm) != t_stream)
  176.             FEwrong_type_argument(Sstream, strm);
  177.         goto BEGIN;
  178.  
  179.     case smm_broadcast:
  180.         return(TRUE);
  181.  
  182.     case smm_concatenated:
  183.         return(FALSE);
  184.  
  185.     case smm_two_way:
  186.         return(TRUE);
  187.  
  188.     case smm_echo:
  189.         return(TRUE);
  190.  
  191.     case smm_string_input:
  192.         return(FALSE);
  193.  
  194.     case smm_string_output:
  195.         return(TRUE);
  196.  
  197.     default:
  198.         error("illegal stream mode");
  199.     }
  200. }
  201.  
  202. object
  203. stream_element_type(strm)
  204. object strm;
  205. {
  206.     object x;
  207.  
  208. BEGIN:
  209.     switch (strm->sm.sm_mode) {
  210.     case smm_input:
  211.     case smm_output:
  212.     case smm_io:
  213.     case smm_probe:
  214.         return(strm->sm.sm_object0);
  215.  
  216.     case smm_synonym:
  217.         strm = symbol_value(strm->sm.sm_object0);
  218.         if (type_of(strm) != t_stream)
  219.             FEwrong_type_argument(Sstream, strm);
  220.         goto BEGIN;
  221.  
  222.     case smm_broadcast:
  223.         x = strm->sm.sm_object0;
  224.         if (endp(x))
  225.             return(Ct);
  226.         return(stream_element_type(x->c.c_car));
  227.  
  228.     case smm_concatenated:
  229.         x = strm->sm.sm_object0;
  230.         if (endp(x))
  231.             return(Ct);
  232.         return(stream_element_type(x->c.c_car));
  233.  
  234.     case smm_two_way:
  235.         return(stream_element_type(strm->sm.sm_object0));
  236.  
  237.     case smm_echo:
  238.         return(stream_element_type(strm->sm.sm_object0));
  239.  
  240.     case smm_string_input:
  241.         return(Sstring_char);
  242.  
  243.     case smm_string_output:
  244.         return(Sstring_char);
  245.  
  246.     default:
  247.         error("illegal stream mode");
  248.     }
  249. }
  250.  
  251. /*
  252.     Open_stream(fn, smm, if_exists, if_does_not_exist)
  253.     opens file fn with mode smm.
  254.     Fn is a namestring.
  255. */
  256. object
  257. open_stream(fn, smm, if_exists, if_does_not_exist)
  258. object fn;
  259. enum smmode smm;
  260. object if_exists, if_does_not_exist;
  261. {
  262.     object x;
  263.     FILE *fp;
  264.     char fname[BUFSIZ];
  265.     int i;
  266.     vs_mark;
  267.  
  268. /*
  269.     if (type_of(fn) != t_string)
  270.         FEwrong_type_argument(Sstring, fn);
  271. */
  272.     if (fn->st.st_fillp > BUFSIZ - 1)
  273.         too_long_file_name(fn);
  274.     for (i = 0;  i < fn->st.st_fillp;  i++)
  275.         fname[i] = fn->st.st_self[i];
  276.     fname[i] = '\0';
  277.     if (smm == smm_input || smm == smm_probe) {
  278.         fp = fopen(fname, "r");
  279.         if (fp == NULL) {
  280.             if (if_does_not_exist == Kerror)
  281.                 cannot_open(fn);
  282.             else if (if_does_not_exist == Kcreate) {
  283.                 fp = fopen(fname, "w");
  284.                 if (fp == NULL)
  285.                     cannot_create(fn);
  286.                 fclose(fp);
  287.                 fp = fopen(fname, "r");
  288.                 if (fp == NULL)
  289.                     cannot_open(fn);
  290.             } else if (if_does_not_exist == Cnil)
  291.                 return(Cnil);
  292.             else
  293.              FEerror("~S is an illegal IF-DOES-NOT-EXIST option.",
  294.                  1, if_does_not_exist);
  295.         }
  296.     } else if (smm == smm_output || smm == smm_io) {
  297.         if (if_exists == Knew_version && if_does_not_exist == Kcreate)
  298.             goto CREATE;
  299.         fp = fopen(fname, "r");
  300.         if (fp != NULL) {
  301.             fclose(fp);
  302.             if (if_exists == Kerror)
  303.                 FEerror("The file ~A already exists.", 1, fn);
  304.             else if (if_exists == Krename) {
  305.                 if (smm == smm_output)
  306.                     fp = backup_fopen(fname, "w");
  307.                 else
  308.                     fp = backup_fopen(fname, "w+");
  309.                 if (fp == NULL)
  310.                     cannot_create(fn);
  311.             } else if (if_exists == Krename_and_delete ||
  312.                    if_exists == Knew_version ||
  313.                    if_exists == Ksupersede) {
  314.                 if (smm == smm_output)
  315.                     fp = fopen(fname, "w");
  316.                 else
  317.                     fp = fopen(fname, "w+");
  318.                 if (fp == NULL)
  319.                     cannot_create(fn);
  320.             } else if (if_exists == Koverwrite) {
  321.                 fp = fopen(fname, "r+");
  322.                 if (fp == NULL)
  323.                     cannot_open(fn);
  324.             } else if (if_exists == Kappend) {
  325.                 if (smm == smm_output)
  326.                     fp = fopen(fname, "a");
  327.                 else
  328.                     fp = fopen(fname, "a+");
  329.                 if (fp == NULL)
  330.                 FEerror("Cannot append to the file ~A.",1,fn);
  331.             } else if (if_exists == Cnil)
  332.                 return(Cnil);
  333.             else
  334.                 FEerror("~S is an illegal IF-EXISTS option.",
  335.                     1, if_exists);
  336.         } else {
  337.             if (if_does_not_exist == Kerror)
  338.                 FEerror("The file ~A does not exist.", 1, fn);
  339.             else if (if_does_not_exist == Kcreate) {
  340.             CREATE:
  341.                 if (smm == smm_output)
  342.                     fp = fopen(fname, "w");
  343.                 else
  344.                     fp = fopen(fname, "w+");
  345.                 if (fp == NULL)
  346.                     cannot_create(fn);
  347.             } else if (if_does_not_exist == Cnil)
  348.                 return(Cnil);
  349.             else
  350.              FEerror("~S is an illegal IF-DOES-NOT-EXIST option.",
  351.                  1, if_does_not_exist);
  352.         }
  353.     } else
  354.         error("illegal stream mode");
  355.     x = alloc_object(t_stream);
  356.     x->sm.sm_mode = (short)smm;
  357.     x->sm.sm_fp = fp;
  358. #ifndef linux
  359.     fp->_base = BASEFF;
  360. #endif
  361.     x->sm.sm_buffer = 0;
  362.     x->sm.sm_object0 = Sstring_char;
  363.     x->sm.sm_object1 = fn;
  364.     x->sm.sm_int0 = x->sm.sm_int1 = 0;
  365.     vs_push(x);
  366.     {char *buf=alloc_contblock(BUFSIZ);
  367.       x->sm.sm_buffer = buf;
  368. #ifdef SGC
  369.     perm_writable(buf,BUFSIZ);
  370. #endif
  371.     setbuf(fp, buf);
  372.     }    
  373.     vs_reset;
  374.     return(x);
  375. }
  376.  
  377. /*
  378.     Close_stream(strm, abort_flag) closes stream strm.
  379.     The abort_flag is not used now.
  380. */
  381. close_stream(strm, abort_flag)
  382. object strm;
  383. bool abort_flag;    /*  Not used now!  */
  384. {
  385.     object x;
  386.  
  387. BEGIN:
  388.     switch (strm->sm.sm_mode) {
  389.     case smm_output:
  390.         if (strm->sm.sm_fp == stdout)
  391.             FEerror("Cannot close the standard output.", 0);
  392.         if (strm->sm.sm_fp == NULL) break;
  393.         fflush(strm->sm.sm_fp);
  394.         if (strm->sm.sm_buffer)
  395.             {insert_contblock(strm->sm.sm_buffer, BUFSIZ);
  396.                 strm->sm.sm_buffer = 0;}
  397.                   else
  398.                    printf("no buffer? %x %d  \n",strm->sm.sm_fp->_base,
  399.              fileno(strm->sm.sm_fp));
  400.         strm->sm.sm_fp->_base = NULL;
  401.         fclose(strm->sm.sm_fp);
  402.         strm->sm.sm_fp = NULL;
  403.         break;
  404.  
  405.     case smm_input:
  406.         if (strm->sm.sm_fp == stdin)
  407.             FEerror("Cannot close the standard input.", 0);
  408.  
  409.     case smm_io:
  410.     case smm_probe:
  411.         if (strm->sm.sm_fp == NULL) break;
  412.         if (strm->sm.sm_buffer)
  413.             {insert_contblock(strm->sm.sm_buffer, BUFSIZ);
  414.                 strm->sm.sm_buffer = 0;}
  415.                   else
  416.                    printf("no buffer? %x %d  \n",strm->sm.sm_fp->_base,
  417.              fileno(strm->sm.sm_fp));
  418.         strm->sm.sm_fp->_base = NULL;
  419.         fclose(strm->sm.sm_fp);
  420.         strm->sm.sm_fp = NULL;
  421.         break;
  422.  
  423.     case smm_synonym:
  424.         strm = symbol_value(strm->sm.sm_object0);
  425.         if (type_of(strm) != t_stream)
  426.             FEwrong_type_argument(Sstream, strm);
  427.         goto BEGIN;
  428.  
  429.     case smm_broadcast:
  430.         for (x = strm->sm.sm_object0; !endp(x); x = x->c.c_cdr)
  431.             close_stream(x->c.c_car, abort_flag);
  432.         break;
  433.  
  434.     case smm_concatenated:
  435.         for (x = strm->sm.sm_object0; !endp(x); x = x->c.c_cdr)
  436.             close_stream(x->c.c_car, abort_flag);
  437.         break;
  438.  
  439.     case smm_two_way:
  440.         close_stream(strm->sm.sm_object0);
  441.         close_stream(strm->sm.sm_object1);
  442.         break;
  443.  
  444.     case smm_echo:
  445.         close_stream(strm->sm.sm_object0);
  446.         close_stream(strm->sm.sm_object1);
  447.         break;
  448.  
  449.     case smm_string_input:
  450.         break;        /*  There is nothing to do.  */
  451.  
  452.     case smm_string_output:
  453.         break;        /*  There is nothing to do.  */
  454.  
  455.     default:
  456.         error("illegal stream mode");
  457.     }
  458. }
  459.  
  460. object
  461. make_two_way_stream(istrm, ostrm)
  462. object istrm, ostrm;
  463. {
  464.     object strm;
  465.  
  466.     strm = alloc_object(t_stream);
  467.     strm->sm.sm_mode = (short)smm_two_way;
  468.     strm->sm.sm_fp = NULL;
  469.     strm->sm.sm_object0 = istrm;
  470.     strm->sm.sm_object1 = ostrm;
  471.     strm->sm.sm_int0 = strm->sm.sm_int1 = 0;
  472.     return(strm);
  473. }
  474.  
  475. object
  476. make_echo_stream(istrm, ostrm)
  477. object istrm, ostrm;
  478. {
  479.     object strm;
  480.  
  481.     strm = make_two_way_stream(istrm, ostrm);
  482.     strm->sm.sm_mode = (short)smm_echo;
  483.     return(strm);
  484. }
  485.  
  486. object
  487. make_string_input_stream(strng, istart, iend)
  488. object strng;
  489. int istart, iend;
  490. {
  491.     object strm;
  492.  
  493.     strm = alloc_object(t_stream);
  494.     strm->sm.sm_mode = (short)smm_string_input;
  495.     strm->sm.sm_fp = NULL;
  496.     strm->sm.sm_object0 = strng;
  497.     strm->sm.sm_object1 = OBJNULL;
  498.     strm->sm.sm_int0 = istart;
  499.     strm->sm.sm_int1 = iend;
  500.     return(strm);
  501. }
  502.  
  503. object
  504. make_string_output_stream(line_length)
  505. int line_length;
  506. {
  507.     object strng, strm;
  508.     vs_mark;
  509.  
  510.     strng = alloc_object(t_string);
  511.     strng->st.st_hasfillp = TRUE;
  512.     strng->st.st_adjustable = TRUE;
  513.     strng->st.st_displaced = Cnil;
  514.     strng->st.st_dim = line_length;
  515.     strng->st.st_fillp = 0;
  516.     strng->st.st_self = NULL;
  517.         /*  For GBC not to go mad.  */
  518.     vs_push(strng);
  519.         /*  Saving for GBC.  */
  520.     strng->st.st_self = alloc_relblock(line_length);
  521.     strm = alloc_object(t_stream);
  522.     strm->sm.sm_mode = (short)smm_string_output;
  523.     strm->sm.sm_fp = NULL;
  524.     strm->sm.sm_object0 = strng;
  525.     strm->sm.sm_object1 = OBJNULL;
  526.     strm->sm.sm_int0 = strm->sm.sm_int1 = 0;
  527.     vs_reset;
  528.     return(strm);
  529. }
  530.  
  531. object
  532. get_output_stream_string(strm)
  533. object strm;
  534. {
  535.     object strng;
  536.  
  537.     strng = copy_simple_string(strm->sm.sm_object0);
  538.     strm->sm.sm_object0->st.st_fillp = 0;
  539.     return(strng);
  540. }
  541.  
  542. int
  543. readc_stream(strm)
  544. object strm;
  545. {
  546.     int c;
  547.  
  548. BEGIN:
  549.     switch (strm->sm.sm_mode) {
  550.     case smm_input:
  551.     case smm_io:
  552.         if (strm->sm.sm_fp == NULL)
  553.             closed_stream(strm);
  554.         c = kclgetc(strm->sm.sm_fp);
  555.         c &= 0377;
  556.         if (kclfeof(strm->sm.sm_fp))
  557.             end_of_stream(strm);
  558.         strm->sm.sm_int0++;
  559.         return(c);
  560.  
  561.     case smm_synonym:
  562.         strm = symbol_value(strm->sm.sm_object0);
  563.         if (type_of(strm) != t_stream)
  564.             FEwrong_type_argument(Sstream, strm);
  565.         goto BEGIN;
  566.  
  567.     case smm_concatenated:
  568.     CONCATENATED:
  569.         if (endp(strm->sm.sm_object0)) {
  570.             end_of_stream(strm);
  571.         }
  572.         if (stream_at_end(strm->sm.sm_object0->c.c_car)) {
  573.             strm->sm.sm_object0
  574.             = strm->sm.sm_object0->c.c_cdr;
  575.             goto CONCATENATED;
  576.         }
  577.         c = readc_stream(strm->sm.sm_object0->c.c_car);
  578.         return(c);
  579.  
  580.     case smm_two_way:
  581. #ifdef UNIX
  582.         if (strm == terminal_io)                /**/
  583.             flush_stream(terminal_io->sm.sm_object1);    /**/
  584. #endif
  585.         strm->sm.sm_int1 = 0;
  586.         strm = strm->sm.sm_object0;
  587.         goto BEGIN;
  588.  
  589.     case smm_echo:
  590.         c = readc_stream(strm->sm.sm_object0);
  591.         if (strm->sm.sm_int0 == 0)
  592.             writec_stream(c, strm->sm.sm_object1);
  593.         else
  594.             --(strm->sm.sm_int0);
  595.         return(c);
  596.  
  597.     case smm_string_input:
  598.         if (strm->sm.sm_int0 >= strm->sm.sm_int1)
  599.             end_of_stream(strm);
  600.         return(strm->sm.sm_object0->st.st_self
  601.                [strm->sm.sm_int0++]);
  602.  
  603.     case smm_output:
  604.     case smm_probe:
  605.     case smm_broadcast:
  606.     case smm_string_output:
  607.         cannot_read(strm);
  608. #ifdef USER_DEFINED_STREAMS
  609.     case smm_user_defined:
  610. #define STM_DATA_STRUCT 0
  611. #define STM_READ_CHAR 1
  612. #define STM_WRITE_CHAR 2
  613. #define STM_UNREAD_CHAR 7
  614. #define STM_FORCE_OUTPUT 4
  615. #define STM_PEEK_CHAR 3
  616. #define STM_CLOSE 5
  617. #define STM_TYPE 6
  618. #define STM_NAME 8
  619. {object val;
  620.         object *old_vs_base = vs_base;
  621.         object *old_vs_top = vs_top;
  622.         vs_base = vs_top;
  623.         vs_push(strm);
  624.         super_funcall(strm->sm.sm_object1->str.str_self[STM_READ_CHAR]);
  625.         val = vs_base[0];
  626.         vs_base = old_vs_base;
  627.         vs_top = old_vs_top;
  628.         if (type_of(val) == t_fixnum)
  629.           return (fix(val));
  630.         if (type_of(val) == t_character)
  631.           return (char_code(val));
  632.           }
  633.  
  634. #endif
  635.  
  636.     default:    
  637.         error("illegal stream mode");
  638.     }
  639. }
  640.  
  641. unreadc_stream(c, strm)
  642. int c;
  643. object strm;
  644. {
  645. BEGIN:
  646.     switch (strm->sm.sm_mode) {
  647.     case smm_input:
  648.     case smm_io:
  649.         if (strm->sm.sm_fp == NULL)
  650.             closed_stream(strm);
  651.         kclungetc(c, strm->sm.sm_fp);
  652.         --strm->sm.sm_int0;
  653.         break;
  654.  
  655.     case smm_synonym:
  656.         strm = symbol_value(strm->sm.sm_object0);
  657.         if (type_of(strm) != t_stream)
  658.             FEwrong_type_argument(Sstream, strm);
  659.         goto BEGIN;
  660.  
  661.     case smm_concatenated:
  662.         if (endp(strm->sm.sm_object0))
  663.             goto UNREAD_ERROR;
  664.         strm = strm->sm.sm_object0->c.c_car;
  665.         goto BEGIN;
  666.  
  667.     case smm_two_way:
  668.         strm = strm->sm.sm_object0;
  669.         goto BEGIN;
  670.  
  671.     case smm_echo:
  672.         unreadc_stream(c, strm->sm.sm_object0);
  673.         (strm->sm.sm_int0)++;
  674.         break;
  675.  
  676.     case smm_string_input:
  677.         if (strm->sm.sm_int0 <= 0)
  678.             goto UNREAD_ERROR;
  679.         --strm->sm.sm_int0;
  680.         break;
  681.  
  682.     case smm_output:
  683.     case smm_probe:
  684.     case smm_broadcast:
  685.     case smm_string_output:
  686.         goto UNREAD_ERROR;
  687.  
  688. #ifdef USER_DEFINED_STREAMS
  689.         case smm_user_defined:
  690.         {object *old_vs_base = vs_base;
  691.          object *old_vs_top = vs_top;
  692.          vs_base = vs_top;
  693.          vs_push(strm);
  694.          /* if there is a file pointer and no define unget function,
  695.                   * then call ungetc */
  696.          if ((strm->sm.sm_fp != NULL ) &&
  697.              strm->sm.sm_object1->str.str_self[STM_UNREAD_CHAR] == Cnil)
  698.            kclungetc(c, strm->sm.sm_fp);
  699.          else
  700.            super_funcall(strm->sm.sm_object1->str.str_self[STM_UNREAD_CHAR]);
  701.          vs_top = old_vs_top;
  702.          vs_base = old_vs_base;
  703.            }
  704.         break;
  705. #endif
  706.     default:
  707.         error("illegal stream mode");
  708.     }
  709.     return;
  710.  
  711. UNREAD_ERROR:
  712.     FEerror("Cannot unread the stream ~S.", 1, strm);
  713. }
  714.  
  715. writec_stream(c, strm)
  716. int c;
  717. object strm;
  718. {
  719.     object x;
  720.     char *p;
  721.     int i;
  722.  
  723. BEGIN:
  724.     switch (strm->sm.sm_mode) {
  725.     case smm_output:
  726.     case smm_io:
  727.         strm->sm.sm_int0++;
  728.         if (c == '\n')
  729.             strm->sm.sm_int1 = 0;
  730.         else if (c == '\t')
  731.             strm->sm.sm_int1 = (strm->sm.sm_int1&~07) + 8;
  732.         else
  733.             strm->sm.sm_int1++;
  734.         if (strm->sm.sm_fp == NULL)
  735.             closed_stream(strm);
  736.         kclputc(c, strm->sm.sm_fp);
  737.         break;
  738.  
  739.     case smm_synonym:
  740.         strm = symbol_value(strm->sm.sm_object0);
  741.         if (type_of(strm) != t_stream)
  742.             FEwrong_type_argument(Sstream, strm);
  743.         goto BEGIN;
  744.  
  745.     case smm_broadcast:
  746.         for (x = strm->sm.sm_object0; !endp(x); x = x->c.c_cdr)
  747.             writec_stream(c, x->c.c_car);
  748.         break;
  749.  
  750.     case smm_two_way:
  751.         strm->sm.sm_int0++;
  752.         if (c == '\n')
  753.             strm->sm.sm_int1 = 0;
  754.         else if (c == '\t')
  755.             strm->sm.sm_int1 = (strm->sm.sm_int1&~07) + 8;
  756.         else
  757.             strm->sm.sm_int1++;
  758.         strm = strm->sm.sm_object1;
  759.         goto BEGIN;
  760.  
  761.     case smm_echo:
  762.         strm = strm->sm.sm_object1;
  763.         goto BEGIN;
  764.  
  765.     case smm_string_output:
  766.         strm->sm.sm_int0++;
  767.         if (c == '\n')
  768.             strm->sm.sm_int1 = 0;
  769.         else if (c == '\t')
  770.             strm->sm.sm_int1 = (strm->sm.sm_int1&~07) + 8;
  771.         else
  772.             strm->sm.sm_int1++;
  773.         x = strm->sm.sm_object0;
  774.         if (x->st.st_fillp >= x->st.st_dim) {
  775.             if (!x->st.st_adjustable)
  776.                 FEerror("The string ~S is not adjustable.",
  777.                     1, x);
  778.             p = alloc_relblock(x->st.st_dim * 2 + 16);
  779.             for (i = 0;  i < x->st.st_dim;  i++)
  780.                 p[i] = x->st.st_self[i];
  781.             i = x->st.st_dim * 2 + 16;
  782. #define    ADIMLIM        16*1024*1024
  783.             if (i >= ADIMLIM)
  784.                 FEerror("Can't extend the string.", 0);
  785.             x->st.st_dim = i;
  786.             adjust_displaced(x, p - x->st.st_self);
  787.         }
  788.         x->st.st_self[x->st.st_fillp++] = c;
  789.         break;
  790.  
  791.     case smm_input:
  792.     case smm_probe:
  793.     case smm_concatenated:
  794.     case smm_string_input:
  795.         cannot_write(strm);
  796.  
  797. #ifdef USER_DEFINED_STREAMS
  798.     case smm_user_defined:
  799.         {object *old_vs_base = vs_base;
  800.          object *old_vs_top = vs_top;
  801.          vs_base = vs_top;
  802.          vs_push(strm);
  803.          vs_push(code_char(c));
  804.          super_funcall(strm->sm.sm_object1->str.str_self[2]);
  805.          vs_base = old_vs_base;
  806.          vs_top = old_vs_top;
  807.          break;
  808.            }
  809.  
  810. #endif
  811.     default:
  812.         error("illegal stream mode");
  813.     }
  814.     return(c);
  815. }
  816.  
  817. writestr_stream(s, strm)
  818. char *s;
  819. object strm;
  820. {
  821.     while (*s != '\0')
  822.         writec_stream(*s++, strm);
  823. }
  824.  
  825. flush_stream(strm)
  826. object strm;
  827. {
  828.     object x;
  829.  
  830. BEGIN:
  831.     switch (strm->sm.sm_mode) {
  832.     case smm_output:
  833.     case smm_io:
  834.         if (strm->sm.sm_fp == NULL)
  835.             closed_stream(strm);
  836.         fflush(strm->sm.sm_fp);
  837.         break;
  838.  
  839.     case smm_synonym:
  840.         strm = symbol_value(strm->sm.sm_object0);
  841.         if (type_of(strm) != t_stream)
  842.             FEwrong_type_argument(Sstream, strm);
  843.         goto BEGIN;
  844.  
  845.     case smm_broadcast:
  846.         for (x = strm->sm.sm_object0; !endp(x); x = x->c.c_cdr)
  847.             flush_stream(x->c.c_car);
  848.         break;
  849.  
  850.     case smm_two_way:
  851.         strm = strm->sm.sm_object1;
  852.         goto BEGIN;
  853.  
  854.     case smm_echo:
  855.         strm = strm->sm.sm_object1;
  856.         goto BEGIN;
  857.  
  858.     case smm_string_output:
  859.         break;
  860.  
  861.     case smm_input:
  862.     case smm_probe:
  863.     case smm_concatenated:
  864.     case smm_string_input:
  865.         FEerror("Cannot flush the stream ~S.", 1, strm);
  866. #ifdef USER_DEFINED_STREAMS
  867.         case smm_user_defined:
  868.         {object *old_vs_base = vs_base;
  869.          object *old_vs_top = vs_top;
  870.          vs_base = vs_top;
  871.          vs_push(strm);
  872.          super_funcall(strm->sm.sm_object1->str.str_self[4]);
  873.          vs_base = old_vs_base;
  874.          vs_top = old_vs_top;
  875.         break;
  876.            }
  877.  
  878. #endif
  879.  
  880.     default:
  881.         error("illegal stream mode");
  882.     }
  883. }
  884.  
  885. bool
  886. stream_at_end(strm)
  887. object strm;
  888. {
  889.     object x;
  890.     int c;
  891.  
  892. BEGIN:
  893.     switch (strm->sm.sm_mode) {
  894.     case smm_io:    
  895.     case smm_input:
  896.         if (strm->sm.sm_fp == NULL)
  897.             closed_stream(strm);
  898.         c = kclgetc(strm->sm.sm_fp);
  899.         if (kclfeof(strm->sm.sm_fp))
  900.             return(TRUE);
  901.         else {
  902.             kclungetc(c, strm->sm.sm_fp);
  903.             return(FALSE);
  904.         }
  905.  
  906.     case smm_output:
  907.         return(FALSE);
  908.  
  909. /*    case smm_io:
  910.         return(FALSE);
  911. */
  912.  
  913.     case smm_probe:
  914.         return(FALSE);
  915.  
  916.     case smm_synonym:
  917.         strm = symbol_value(strm->sm.sm_object0);
  918.         if (type_of(strm) != t_stream)
  919.             FEwrong_type_argument(Sstream, strm);
  920.         goto BEGIN;
  921.  
  922.     case smm_broadcast:
  923.         return(FALSE);
  924.  
  925.     case smm_concatenated:
  926.     CONCATENATED:
  927.         if (endp(strm->sm.sm_object0))
  928.             return(TRUE);
  929.         if (stream_at_end(strm->sm.sm_object0->c.c_car)) {
  930.             strm->sm.sm_object0
  931.             = strm->sm.sm_object0->c.c_cdr;
  932.             goto CONCATENATED;
  933.         } else
  934.             return(FALSE);
  935.  
  936.     case smm_two_way:
  937. #ifdef UNIX
  938.         if (strm == terminal_io)                /**/
  939.             flush_stream(terminal_io->sm.sm_object1);    /**/
  940. #endif
  941.         strm = strm->sm.sm_object0;
  942.         goto BEGIN;
  943.  
  944.     case smm_echo:
  945.         strm = strm->sm.sm_object0;
  946.         goto BEGIN;
  947.  
  948.     case smm_string_input:
  949.         if (strm->sm.sm_int0 >= strm->sm.sm_int1)
  950.             return(TRUE);
  951.         else
  952.             return(FALSE);
  953.  
  954.     case smm_string_output:
  955.         return(FALSE);
  956.  
  957. #ifdef USER_DEFINED_STREAMS
  958.         case smm_user_defined:
  959.           return(FALSE);
  960. #endif
  961.     default:
  962.         error("illegal stream mode");
  963.     }
  964. }
  965.  
  966. #ifdef HAVE_IOCTL
  967. #include <sys/ioctl.h>
  968. #endif
  969.  
  970. bool
  971. listen_stream(strm)
  972. object strm;
  973. {
  974.     object x;
  975.     int c;
  976.  
  977. BEGIN:
  978.     switch (strm->sm.sm_mode) {
  979.     case smm_input:
  980.     case smm_io:
  981.  
  982.         if (strm->sm.sm_fp == NULL)
  983.             closed_stream(strm);
  984.         if (feof(strm->sm.sm_fp))
  985.                 return(FALSE);
  986. #ifdef LISTEN_FOR_INPUT
  987.         LISTEN_FOR_INPUT(strm->sm.sm_fp);
  988. #endif
  989.         return TRUE;
  990.  
  991.     case smm_synonym:
  992.         strm = symbol_value(strm->sm.sm_object0);
  993.         if (type_of(strm) != t_stream)
  994.             FEwrong_type_argument(Sstream, strm);
  995.         goto BEGIN;
  996.  
  997.     case smm_concatenated:
  998.     CONCATENATED:
  999.         if (endp(strm->sm.sm_object0))
  1000.             return(FALSE);
  1001.         strm = strm->sm.sm_object0->c.c_car;    /* Incomplete! */
  1002.         goto BEGIN;
  1003.  
  1004.     case smm_two_way:
  1005.     case smm_echo:
  1006.         strm = strm->sm.sm_object0;
  1007.         goto BEGIN;
  1008.  
  1009.     case smm_string_input:
  1010.         if (strm->sm.sm_int0 < strm->sm.sm_int1)
  1011.             return(TRUE);
  1012.         else
  1013.             return(FALSE);
  1014.  
  1015.     case smm_output:
  1016.     case smm_probe:
  1017.     case smm_broadcast:
  1018.     case smm_string_output:
  1019.         FEerror("Can't listen to ~S.", 1, strm);
  1020.  
  1021.     default:
  1022.         error("illegal stream mode");
  1023.     }
  1024. }
  1025.  
  1026. int
  1027. file_position(strm)
  1028. object strm;
  1029. {
  1030. BEGIN:
  1031.     switch (strm->sm.sm_mode) {
  1032.     case smm_input:
  1033.     case smm_output:
  1034.     case smm_io:
  1035.         /*  return(strm->sm.sm_int0);  */
  1036.         if (strm->sm.sm_fp == NULL)
  1037.             closed_stream(strm);
  1038.         return(ftell(strm->sm.sm_fp));
  1039.  
  1040.     case smm_string_output:
  1041.         return(strm->sm.sm_object0->st.st_fillp);
  1042.  
  1043.     case smm_synonym:
  1044.         strm = symbol_value(strm->sm.sm_object0);
  1045.         if (type_of(strm) != t_stream)
  1046.             FEwrong_type_argument(Sstream, strm);
  1047.         goto BEGIN;
  1048.  
  1049.     case smm_probe:
  1050.     case smm_broadcast:
  1051.     case smm_concatenated:
  1052.     case smm_two_way:
  1053.     case smm_echo:
  1054.     case smm_string_input:
  1055.         return(-1);
  1056.  
  1057.     default:
  1058.         error("illegal stream mode");
  1059.     }
  1060. }
  1061.  
  1062. int
  1063. file_position_set(strm, disp)
  1064. object strm;
  1065. int disp;
  1066. {
  1067. BEGIN:
  1068.     switch (strm->sm.sm_mode) {
  1069.     case smm_input:
  1070.     case smm_output:
  1071.     case smm_io:
  1072.         if (strm->sm.sm_fp == NULL)
  1073.             closed_stream(strm);
  1074.         if (fseek(strm->sm.sm_fp, disp, 0) < 0)
  1075.             return(-1);
  1076.         strm->sm.sm_int0 = disp;
  1077.         return(0);
  1078.  
  1079.     case smm_string_output:
  1080.         if (disp < strm->sm.sm_object0->st.st_fillp) {
  1081.             strm->sm.sm_object0->st.st_fillp = disp;
  1082.             strm->sm.sm_int0 = disp;
  1083.         } else {
  1084.             disp -= strm->sm.sm_object0->st.st_fillp;
  1085.             while (disp-- > 0)
  1086.                 writec_stream(' ', strm);
  1087.         }
  1088.         return(0);
  1089.  
  1090.     case smm_synonym:
  1091.         strm = symbol_value(strm->sm.sm_object0);
  1092.         if (type_of(strm) != t_stream)
  1093.             FEwrong_type_argument(Sstream, strm);
  1094.         goto BEGIN;
  1095.  
  1096.     case smm_probe:
  1097.     case smm_broadcast:
  1098.     case smm_concatenated:
  1099.     case smm_two_way:
  1100.     case smm_echo:
  1101.     case smm_string_input:
  1102.         return(-1);
  1103.  
  1104.     default:
  1105.         error("illegal stream mode");
  1106.     }
  1107. }
  1108.  
  1109. int
  1110. file_length(strm)
  1111. object strm;
  1112. {
  1113. BEGIN:
  1114.     switch (strm->sm.sm_mode) {
  1115.     case smm_input:
  1116.     case smm_output:
  1117.     case smm_io:
  1118.         if (strm->sm.sm_fp == NULL)
  1119.             closed_stream(strm);
  1120.         return(file_len(strm->sm.sm_fp));
  1121.  
  1122.     case smm_synonym:
  1123.         strm = symbol_value(strm->sm.sm_object0);
  1124.         if (type_of(strm) != t_stream)
  1125.             FEwrong_type_argument(Sstream, strm);
  1126.         goto BEGIN;
  1127.  
  1128.     case smm_probe:
  1129.     case smm_broadcast:
  1130.     case smm_concatenated:
  1131.     case smm_two_way:
  1132.     case smm_echo:
  1133.     case smm_string_input:
  1134.     case smm_string_output:
  1135.         return(-1);
  1136.  
  1137.     default:
  1138.         error("illegal stream mode");
  1139.     }
  1140. }
  1141.  
  1142. int
  1143. file_column(strm)
  1144. object strm;
  1145. {
  1146.     int i;
  1147.     object x;
  1148.  
  1149. BEGIN:
  1150.     switch (strm->sm.sm_mode) {
  1151.     case smm_output:
  1152.     case smm_io:
  1153.     case smm_two_way:
  1154.     case smm_string_output:
  1155.         return(strm->sm.sm_int1);
  1156.  
  1157.     case smm_synonym:
  1158.         strm = symbol_value(strm->sm.sm_object0);
  1159.         if (type_of(strm) != t_stream)
  1160.             FEwrong_type_argument(Sstream, strm);
  1161.         goto BEGIN;
  1162.  
  1163.     case smm_echo:
  1164.         strm = strm->sm.sm_object1;
  1165.         goto BEGIN;
  1166.  
  1167.     case smm_input:
  1168.     case smm_probe:
  1169.     case smm_string_input:
  1170.         return(-1);
  1171.  
  1172.     case smm_concatenated:
  1173.         if (endp(strm->sm.sm_object0))
  1174.             return(-1);
  1175.         strm = strm->sm.sm_object0->c.c_car;
  1176.         goto BEGIN;
  1177.  
  1178.     case smm_broadcast:
  1179.         for (x = strm->sm.sm_object0; !endp(x); x = x->c.c_cdr) {
  1180.             i = file_column(x->c.c_car);
  1181.             if (i >= 0)
  1182.                 return(i);
  1183.         }
  1184.         return(-1);
  1185.  
  1186. #ifdef USER_DEFINED_STREAMS
  1187.     case smm_user_defined: /* not right but what is? */
  1188.         return(-1);
  1189.     
  1190. #endif
  1191.     default:
  1192.         error("illegal stream mode");
  1193.     }
  1194. }
  1195.  
  1196. load(s)
  1197. char *s;
  1198. {
  1199.     object filename, strm, x;
  1200.     vs_mark;
  1201.  
  1202.     filename = make_simple_string(s);
  1203.     vs_push(filename);
  1204.     strm = open_stream(filename, smm_input, Cnil, Kerror);
  1205.     vs_push(strm);
  1206.     for (;;) {
  1207.         preserving_whitespace_flag = FALSE;
  1208.         detect_eos_flag = TRUE;
  1209.         x = read_object_non_recursive(strm);
  1210.         if (x == OBJNULL)
  1211.             break;
  1212.         vs_push(x);
  1213.         ieval(x);
  1214.         vs_pop;
  1215.     }
  1216.     close_stream(strm);
  1217.     vs_reset;
  1218. }
  1219.  
  1220. Lmake_synonym_stream()
  1221. {
  1222.     object x;
  1223.  
  1224.     check_arg(1);
  1225.     check_type_symbol(&vs_base[0]);
  1226.     x = alloc_object(t_stream);
  1227.     x->sm.sm_mode = (short)smm_synonym;
  1228.     x->sm.sm_fp = NULL;
  1229.     x->sm.sm_object0 = vs_base[0];
  1230.     x->sm.sm_object1 = OBJNULL;
  1231.     x->sm.sm_int0 = x->sm.sm_int1 = 0;
  1232.     vs_base[0] = x;
  1233. }
  1234.  
  1235. Lmake_broadcast_stream()
  1236. {
  1237.     object x;
  1238.     int narg, i;
  1239.  
  1240.     narg = vs_top - vs_base;
  1241.     for (i = 0;  i < narg;  i++)
  1242.         if (type_of(vs_base[i]) != t_stream ||
  1243.             !output_stream_p(vs_base[i]))
  1244.             cannot_write(vs_base[i]);
  1245.     vs_push(Cnil);
  1246.     for (i = narg;  i > 0;  --i)
  1247.         stack_cons();
  1248.     x = alloc_object(t_stream);
  1249.     x->sm.sm_mode = (short)smm_broadcast;
  1250.     x->sm.sm_fp = NULL;
  1251.     x->sm.sm_object0 = vs_base[0];
  1252.     x->sm.sm_object1 = OBJNULL;
  1253.     x->sm.sm_int0 = x->sm.sm_int1 = 0;
  1254.     vs_base[0] = x;
  1255. }
  1256.  
  1257. Lmake_concatenated_stream()
  1258. {
  1259.     object x;
  1260.     int narg, i;
  1261.  
  1262.     narg = vs_top - vs_base;
  1263.     for (i = 0;  i < narg;  i++)
  1264.         if (type_of(vs_base[i]) != t_stream ||
  1265.             !input_stream_p(vs_base[i]))
  1266.             cannot_read(vs_base[i]);
  1267.     vs_push(Cnil);
  1268.     for (i = narg;  i > 0;  --i)
  1269.         stack_cons();
  1270.     x = alloc_object(t_stream);
  1271.     x->sm.sm_mode = (short)smm_concatenated;
  1272.     x->sm.sm_fp = NULL;
  1273.     x->sm.sm_object0 = vs_base[0];
  1274.     x->sm.sm_object1 = OBJNULL;
  1275.     x->sm.sm_int0 = x->sm.sm_int1 = 0;
  1276.     vs_base[0] = x;
  1277. }
  1278.  
  1279. Lmake_two_way_stream()
  1280. {
  1281.     check_arg(2);
  1282.  
  1283.     if (type_of(vs_base[0]) != t_stream ||
  1284.         !input_stream_p(vs_base[0]))
  1285.         cannot_read(vs_base[0]);
  1286.     if (type_of(vs_base[1]) != t_stream ||
  1287.         !output_stream_p(vs_base[1]))
  1288.         cannot_write(vs_base[1]);
  1289.     vs_base[0] = make_two_way_stream(vs_base[0], vs_base[1]);
  1290.     vs_pop;
  1291. }
  1292.  
  1293. Lmake_echo_stream()
  1294. {
  1295.     check_arg(2);
  1296.  
  1297.     if (type_of(vs_base[0]) != t_stream ||
  1298.         !input_stream_p(vs_base[0]))
  1299.         cannot_read(vs_base[0]);
  1300.     if (type_of(vs_base[1]) != t_stream ||
  1301.         !output_stream_p(vs_base[1]))
  1302.         cannot_write(vs_base[1]);
  1303.     vs_base[0] = make_echo_stream(vs_base[0], vs_base[1]);
  1304.     vs_pop;
  1305. }
  1306.  
  1307. @(defun make_string_input_stream (strng &o istart iend)
  1308.     int s, e;
  1309. @
  1310.     check_type_string(&strng);
  1311.     if (istart == Cnil)
  1312.         s = 0;
  1313.     else if (type_of(istart) != t_fixnum)
  1314.         goto E;
  1315.     else
  1316.         s = fix(istart);
  1317.     if (iend == Cnil)
  1318.         e = strng->st.st_fillp;
  1319.     else if (type_of(iend) != t_fixnum)
  1320.         goto E;
  1321.     else
  1322.         e = fix(iend);
  1323.     if (s < 0 || e > strng->st.st_fillp || s > e)
  1324.         goto E;
  1325.     @(return `make_string_input_stream(strng, s, e)`)
  1326.  
  1327. E:
  1328.     FEerror("~S and ~S are illegal as :START and :END~%\
  1329. for the string ~S.",
  1330.         3, istart, iend, strng);
  1331. @)
  1332.  
  1333. Lmake_string_output_stream()
  1334. {
  1335.     check_arg(0);
  1336.     vs_push(make_string_output_stream(64));
  1337. }
  1338.  
  1339. Lget_output_stream_string()
  1340. {
  1341.     check_arg(1);
  1342.  
  1343.     if (type_of(vs_base[0]) != t_stream ||
  1344.         (enum smmode)vs_base[0]->sm.sm_mode != smm_string_output)
  1345.         FEerror("~S is not a string-output stream.", 1, vs_base[0]);
  1346.     vs_base[0] = get_output_stream_string(vs_base[0]);
  1347. }
  1348.  
  1349. /*
  1350.     (SI:OUTPUT-STREAM-STRING string-output-stream)
  1351.  
  1352.         extracts the string associated with the given
  1353.         string-output-stream.
  1354. */
  1355. siLoutput_stream_string()
  1356. {
  1357.     check_arg(1);
  1358.     if (type_of(vs_base[0]) != t_stream ||
  1359.         (enum smmode)vs_base[0]->sm.sm_mode != smm_string_output)
  1360.         FEerror("~S is not a string-output stream.", 1, vs_base[0]);
  1361.     vs_base[0] = vs_base[0]->sm.sm_object0;
  1362. }
  1363.  
  1364. Lstreamp()
  1365. {
  1366.     check_arg(1);
  1367.  
  1368.     if (type_of(vs_base[0]) == t_stream)
  1369.         vs_base[0] = Ct;
  1370.     else
  1371.         vs_base[0] = Cnil;
  1372. }
  1373.  
  1374. Linput_stream_p()
  1375. {
  1376.     check_arg(1);
  1377.  
  1378.     check_type_stream(&vs_base[0]);
  1379.     if (input_stream_p(vs_base[0]))
  1380.         vs_base[0] = Ct;
  1381.     else
  1382.         vs_base[0] = Cnil;
  1383. }
  1384.  
  1385. Loutput_stream_p()
  1386. {
  1387.     check_arg(1);
  1388.  
  1389.     check_type_stream(&vs_base[0]);
  1390.     if (output_stream_p(vs_base[0]))
  1391.         vs_base[0] = Ct;
  1392.     else
  1393.         vs_base[0] = Cnil;
  1394. }
  1395.  
  1396. Lstream_element_type()
  1397. {
  1398.     check_arg(1);
  1399.  
  1400.     check_type_stream(&vs_base[0]);
  1401.     vs_base[0] = stream_element_type(vs_base[0]);
  1402. }
  1403.  
  1404. @(defun close (strm &key abort)
  1405. @
  1406.     check_type_stream(&strm);
  1407.     close_stream(strm, abort != Cnil);
  1408.     @(return Ct)
  1409. @)
  1410.  
  1411. @(defun open (filename
  1412.           &key (direction Kinput)
  1413.            (element_type Sstring_char)
  1414.            (if_exists Cnil iesp)
  1415.            (if_does_not_exist Cnil idnesp)
  1416.           &aux strm)
  1417.     enum smmode smm;
  1418. @
  1419.     check_type_or_pathname_string_symbol_stream(&filename);
  1420.     filename = coerce_to_namestring(filename);
  1421.     if (direction == Kinput) {
  1422.         smm = smm_input;
  1423.         if (!idnesp)
  1424.             if_does_not_exist = Kerror;
  1425.     } else if (direction == Koutput) {
  1426.         smm = smm_output;
  1427.         if (!iesp)
  1428.             if_exists = Knew_version;
  1429.         if (!idnesp) {
  1430.             if (if_exists == Koverwrite ||
  1431.                 if_exists == Kappend)
  1432.                 if_does_not_exist = Kerror;
  1433.             else
  1434.                 if_does_not_exist = Kcreate;
  1435.         }
  1436.     } else if (direction == Kio) {
  1437.         smm = smm_io;
  1438.         if (!iesp)
  1439.             if_exists = Knew_version;
  1440.         if (!idnesp) {
  1441.             if (if_exists == Koverwrite ||
  1442.                 if_exists == Kappend)
  1443.                 if_does_not_exist = Kerror;
  1444.             else
  1445.                 if_does_not_exist = Kcreate;
  1446.         }
  1447.     } else if (direction == Kprobe) {
  1448.         smm = smm_probe;
  1449.         if (!idnesp)
  1450.             if_does_not_exist = Cnil;
  1451.     } else
  1452.         FEerror("~S is an illegal DIRECTION for OPEN.",
  1453.             1, direction);
  1454.     strm = open_stream(filename, smm, if_exists, if_does_not_exist);
  1455.     @(return strm)
  1456. @)
  1457.  
  1458. @(defun file_position (file_stream &o position)
  1459.     int i;
  1460. @
  1461.     check_type_stream(&file_stream);
  1462.     if (position == Cnil) {
  1463.         i = file_position(file_stream);
  1464.         if (i < 0)
  1465.             @(return Cnil)
  1466.         @(return `make_fixnum(i)`)
  1467.     } else {
  1468.         if (position == Kstart)
  1469.             i = 0;
  1470.         else if (position == Kend)
  1471.             i = file_length(file_stream);
  1472.         else if (type_of(position) != t_fixnum ||
  1473.             (i = fix((position))) < 0)
  1474.             FEerror("~S is an illegal file position~%\
  1475. for the file-stream ~S.",
  1476.                 2, position, file_stream);
  1477.         if (file_position_set(file_stream, i) < 0)
  1478.             @(return Cnil)
  1479.         @(return Ct)
  1480.     }    
  1481. @)
  1482.  
  1483. Lfile_length()
  1484. {
  1485.     int i;
  1486.  
  1487.     check_arg(1);
  1488.     check_type_stream(&vs_base[0]);
  1489.     i = file_length(vs_base[0]);
  1490.     if (i < 0)
  1491.         vs_base[0] = Cnil;
  1492.     else
  1493.         vs_base[0] = make_fixnum(i);
  1494. }
  1495.  
  1496. object siVload_pathname;
  1497.  
  1498. @(defun load (pathname
  1499.           &key (verbose `symbol_value(Vload_verbose)`)
  1500.             print
  1501.             (if_does_not_exist Kerror)
  1502.           &aux pntype fasl_filename lsp_filename filename
  1503.            defaults strm stdoutput x
  1504.            package)
  1505.     bds_ptr old_bds_top;
  1506.     int i;
  1507.     object strm1;
  1508. @
  1509.     check_type_or_pathname_string_symbol_stream(&pathname);
  1510.     pathname = coerce_to_pathname(pathname);
  1511.     defaults = symbol_value(Vdefault_pathname_defaults);
  1512.     defaults = coerce_to_pathname(defaults);
  1513.     pathname = merge_pathnames(pathname, defaults, Knewest);
  1514.     pntype = pathname->pn.pn_type;
  1515.     filename = coerce_to_namestring(pathname);
  1516.         old_bds_top=bds_top;
  1517.       if (pntype == Cnil || pntype == Kwild ||
  1518.         type_of(pntype) == t_string &&
  1519. #ifdef UNIX
  1520.         string_eq(pntype, FASL_string)) {
  1521. #endif
  1522. #ifdef AOSVS
  1523.  
  1524. #endif
  1525.         pathname->pn.pn_type = FASL_string;
  1526.         fasl_filename = coerce_to_namestring(pathname);
  1527.     }
  1528.     if (pntype == Cnil || pntype == Kwild ||
  1529.         type_of(pntype) == t_string &&
  1530. #ifdef UNIX
  1531.         string_eq(pntype, LSP_string)) {
  1532. #endif
  1533. #ifdef AOSVS
  1534.  
  1535. #endif
  1536.         pathname->pn.pn_type = LSP_string;
  1537.         lsp_filename = coerce_to_namestring(pathname);
  1538.     }
  1539.     if (fasl_filename != Cnil && file_exists(fasl_filename)) {
  1540.         if (verbose != Cnil) {
  1541.             setupPRINTdefault(fasl_filename);
  1542.             if (file_column(PRINTstream) != 0)
  1543.                 write_str("\n");
  1544.             write_str("Loading ");
  1545.             PRINTescape = FALSE;
  1546.             write_object(fasl_filename, 0);
  1547.             write_str("\n");
  1548.             cleanupPRINT();
  1549.             flush_stream(PRINTstream);
  1550.         }
  1551.         package = symbol_value(Vpackage);
  1552.         bds_bind(Vpackage, package);
  1553.         bds_bind(siVload_pathname,fasl_filename);
  1554.         i = fasload(fasl_filename);
  1555.         if (print != Cnil) {
  1556.             setupPRINTdefault(Cnil);
  1557.             vs_top = PRINTvs_top;
  1558.             if (file_column(PRINTstream) != 0)
  1559.                 write_str("\n");
  1560.             write_str("Fasload successfully ended.");
  1561.             write_str("\n");
  1562.             cleanupPRINT();
  1563.             flush_stream(PRINTstream);
  1564.         }
  1565.         bds_unwind(old_bds_top);
  1566.         if (verbose != Cnil) {
  1567.             setupPRINTdefault(fasl_filename);
  1568.             if (file_column(PRINTstream) != 0)
  1569.                 write_str("\n");
  1570.             write_str("Finished loading ");
  1571.             PRINTescape = FALSE;
  1572.             write_object(fasl_filename, 0);
  1573.             write_str("\n");
  1574.             cleanupPRINT();
  1575.             flush_stream(PRINTstream);
  1576.         }
  1577.         @(return `make_fixnum(i)`)
  1578.     }
  1579.     if (lsp_filename != Cnil && file_exists(lsp_filename)) {
  1580.         filename = lsp_filename;
  1581.     }
  1582.     if (if_does_not_exist != Cnil)
  1583.         if_does_not_exist = Kerror;
  1584.     strm1 = strm
  1585.     = open_stream(filename, smm_input, Cnil, if_does_not_exist);
  1586.     if (strm == Cnil)
  1587.         @(return Cnil)
  1588.     if (verbose != Cnil) {
  1589.         setupPRINTdefault(filename);
  1590.         if (file_column(PRINTstream) != 0)
  1591.             write_str("\n");
  1592.         write_str("Loading ");
  1593.         PRINTescape = FALSE;
  1594.         write_object(filename, 0);
  1595.         write_str("\n");
  1596.         cleanupPRINT();
  1597.         flush_stream(PRINTstream);
  1598.     }
  1599.     package = symbol_value(Vpackage);
  1600.     bds_bind(siVload_pathname,pathname);
  1601.     bds_bind(Vpackage, package);
  1602.     bds_bind(Vstandard_input, strm);
  1603.     frs_push(FRS_PROTECT, Cnil);
  1604.     if (nlj_active) {
  1605.         close_stream(strm1, TRUE);
  1606.         nlj_active = FALSE;
  1607.         frs_pop();
  1608.         bds_unwind(old_bds_top);
  1609.         unwind(nlj_fr, nlj_tag);
  1610.     }
  1611.     for (;;) {
  1612.         preserving_whitespace_flag = FALSE;
  1613.         detect_eos_flag = TRUE;
  1614.         x = read_object_non_recursive(strm);
  1615.         if (x == OBJNULL)
  1616.             break;
  1617.         {
  1618.             object *base = vs_base, *top = vs_top, *lex = lex_env;
  1619.             object xx;
  1620.  
  1621.             lex_new();
  1622.             eval(x);
  1623.             xx = vs_base[0];
  1624.             lex_env = lex;
  1625.             vs_top = top;
  1626.             vs_base = base;
  1627.             x = xx;
  1628.         }
  1629.         if (print != Cnil) {
  1630.             setupPRINTdefault(x);
  1631.             write_object(x, 0);
  1632.             write_str("\n");
  1633.             cleanupPRINT();
  1634.             flush_stream(PRINTstream);
  1635.         }
  1636.     }
  1637.     close_stream(strm, TRUE);
  1638.     frs_pop();
  1639.     bds_unwind(old_bds_top);
  1640.     if (verbose != Cnil) {
  1641.         setupPRINTdefault(filename);
  1642.         if (file_column(PRINTstream) != 0)
  1643.             write_str("\n");
  1644.         write_str("Finished loading ");
  1645.         PRINTescape = FALSE;
  1646.         write_object(filename, 0);
  1647.         write_str("\n");
  1648.         cleanupPRINT();
  1649.         flush_stream(PRINTstream);
  1650.     }
  1651.     @(return Ct)
  1652. @)
  1653.  
  1654. siLget_string_input_stream_index()
  1655. {
  1656.     check_arg(1);
  1657.     check_type_stream(&vs_base[0]);
  1658.     if ((enum smmode)vs_base[0]->sm.sm_mode != smm_string_input)
  1659.         FEerror("~S is not a string-input stream.", 1, vs_base[0]);
  1660.     vs_base[0] = make_fixnum(vs_base[0]->sm.sm_int0);
  1661. }
  1662.  
  1663. siLmake_string_output_stream_from_string()
  1664. {
  1665.     object strng, strm;
  1666.  
  1667.     check_arg(1);
  1668.     strng = vs_base[0];
  1669.     if (type_of(strng) != t_string || !strng->st.st_hasfillp)
  1670.         FEerror("~S is not a string with a fill-pointer.", 1, strng);
  1671.     strm = alloc_object(t_stream);
  1672.     strm->sm.sm_mode = (short)smm_string_output;
  1673.     strm->sm.sm_fp = NULL;
  1674.     strm->sm.sm_object0 = strng;
  1675.     strm->sm.sm_object1 = OBJNULL;
  1676.     strm->sm.sm_int0 = strng->st.st_fillp;
  1677.     strm->sm.sm_int1 = 0;
  1678.     vs_base[0] = strm;
  1679. }
  1680.  
  1681. siLcopy_stream()
  1682. {
  1683.     object in, out;
  1684.  
  1685.     check_arg(2);
  1686.     check_type_stream(&vs_base[0]);
  1687.     check_type_stream(&vs_base[1]);
  1688.     in = vs_base[0];
  1689.     out = vs_base[1];
  1690.     while (!stream_at_end(in))
  1691.         writec_stream(readc_stream(in), out);
  1692.     flush_stream(out);
  1693.     vs_base[0] = Ct;
  1694.     vs_pop;
  1695. #ifdef AOSVS
  1696.  
  1697. #endif
  1698. }
  1699.  
  1700.  
  1701. too_long_file_name(fn)
  1702. object fn;
  1703. {
  1704.     FEerror("~S is a too long file name.", 1, fn);
  1705. }
  1706.  
  1707. cannot_open(fn)
  1708. object fn;
  1709. {
  1710.     FEerror("Cannot open the file ~A.", 1, fn);
  1711. }
  1712.  
  1713. cannot_create(fn)
  1714. object fn;
  1715. {
  1716.     FEerror("Cannot create the file ~A.", 1, fn);
  1717. }
  1718.  
  1719. cannot_read(strm)
  1720. object strm;
  1721. {
  1722.     FEerror("Cannot read the stream ~S.", 1, strm);
  1723. }
  1724.  
  1725. cannot_write(strm)
  1726. object strm;
  1727. {
  1728.     FEerror("Cannot write to the stream ~S.", 1, strm);
  1729. }
  1730.  
  1731. #ifdef USER_DEFINED_STREAMS
  1732. /* more support for user defined streams */
  1733. siLuser_stream_state()
  1734. {     
  1735.   check_arg(1);
  1736.  
  1737.   if(vs_base[0]->sm.sm_object1)
  1738.       vs_base[0] = vs_base[0]->sm.sm_object1->str.str_self[0]; 
  1739.   else
  1740.     FEerror("Stream data NULL ~S", 1, vs_base[0]);
  1741. }
  1742. #endif
  1743.  
  1744. closed_stream(strm)
  1745. object strm;
  1746. {
  1747.     FEerror("The stream ~S is already closed.", 1, strm);
  1748. }
  1749.  
  1750.  
  1751.  
  1752. /* returns a stream with which one can safely do fwrite to the x->sm.sm_fp
  1753.    or nil.
  1754.    */
  1755.  
  1756.  
  1757. /* coerce stream to one so that x->sm.sm_fp is suitable for fread and fwrite,
  1758.    Return nil if this is not possible.
  1759.    */
  1760.  
  1761. object
  1762. coerce_stream(strm,out)
  1763. object strm;
  1764. int out;
  1765. {
  1766.  BEGIN:
  1767.  if (type_of(strm) != t_stream)
  1768.    FEwrong_type_argument(Sstream, strm);
  1769.  switch (strm->sm.sm_mode){
  1770.  case smm_synonym:
  1771.   strm = symbol_value(strm->sm.sm_object0);
  1772.   if (type_of(strm) != t_stream)
  1773.             FEwrong_type_argument(Sstream, strm);
  1774.         goto BEGIN;
  1775.  
  1776.  case smm_two_way:
  1777.  case smm_echo:
  1778.   if (out)strm = strm->sm.sm_object1;
  1779.     else strm = strm->sm.sm_object0;
  1780.   goto BEGIN;
  1781.  case smm_output:
  1782.   if (!out) cannot_read(strm);
  1783.   break;
  1784.  case smm_input:
  1785.     if (out) cannot_write(strm);
  1786.   break;
  1787.  default:
  1788.   strm=Cnil;
  1789.   }
  1790.  if (strm!=Cnil
  1791.      && (strm->sm.sm_fp == NULL))
  1792.    closed_stream(strm);
  1793.  return(strm);
  1794. }
  1795.  
  1796. siLfp_output_stream()
  1797. {check_arg(1);
  1798.  vs_base[0]=coerce_stream(vs_base[0],1);
  1799. }
  1800.  
  1801. siLfp_input_stream()
  1802. {check_arg(1);
  1803.  vs_base[0]=coerce_stream(vs_base[0],0);
  1804. }
  1805.  
  1806.  
  1807. @(defun fwrite (vector start count stream)
  1808.   unsigned char *p;
  1809.   int n,beg;
  1810. @  
  1811.   stream=coerce_stream(stream,1);
  1812.   if (stream==Cnil) @(return Cnil);
  1813.   p = vector->ust.ust_self;
  1814.   beg = ((type_of(start)==t_fixnum) ? fix(start) : 0);
  1815.   n = ((type_of(count)==t_fixnum) ? fix(count) : (vector->st.st_fillp - beg));
  1816.   if (fwrite(p+beg,1,n,stream->sm.sm_fp)) @(return Ct);
  1817.   @(return Cnil);
  1818. @)
  1819.  
  1820. @(defun fread (vector start count stream)
  1821.   unsigned char *p;
  1822.   int n,beg;
  1823. @  
  1824.   stream=coerce_stream(stream,0);
  1825.   if (stream==Cnil) @(return Cnil);
  1826.   p = vector->ust.ust_self;
  1827.   beg = ((type_of(start)==t_fixnum) ? fix(start) : 0);
  1828.   n = ((type_of(count)==t_fixnum) ? fix(count) : (vector->st.st_fillp - beg));
  1829.   if (n=fread(p+beg,1,n,stream->sm.sm_fp))
  1830.       @(return `make_fixnum(n)`);
  1831.   @(return Cnil);
  1832. @)
  1833.  
  1834.  
  1835.  
  1836. init_file()
  1837. {
  1838.     object standard_input;
  1839.     object standard_output;
  1840.     object standard;
  1841.     object x;
  1842. #ifdef AOSVS1
  1843.  
  1844.  
  1845.  
  1846. #endif
  1847.  
  1848.     standard_input = alloc_object(t_stream);
  1849.     standard_input->sm.sm_mode = (short)smm_input;
  1850.     standard_input->sm.sm_fp = stdin;
  1851.     standard_input->sm.sm_object0 = Sstring_char;
  1852.     standard_input->sm.sm_object1
  1853. #ifdef UNIX
  1854.     = make_simple_string("stdin");
  1855. #endif
  1856. #ifdef AOSVS
  1857.  
  1858. #endif
  1859.     standard_input->sm.sm_int0 = 0;
  1860.     standard_input->sm.sm_int1 = 0;
  1861.  
  1862.     standard_output = alloc_object(t_stream);
  1863.     standard_output->sm.sm_mode = (short)smm_output;
  1864.     standard_output->sm.sm_fp = stdout;
  1865.     standard_output->sm.sm_object0 = Sstring_char;
  1866.     standard_output->sm.sm_object1
  1867. #ifdef UNIX
  1868.     = make_simple_string("stdout");
  1869. #endif
  1870. #ifdef AOSVS
  1871.  
  1872. #endif
  1873.     standard_output->sm.sm_int0 = 0;
  1874.     standard_output->sm.sm_int1 = 0;
  1875.  
  1876.     terminal_io = standard
  1877.     = make_two_way_stream(standard_input, standard_output);
  1878.     enter_mark_origin(&terminal_io);
  1879.  
  1880.     Vterminal_io
  1881.     = make_special("*TERMINAL-IO*", standard);
  1882.  
  1883.     x = alloc_object(t_stream);
  1884.     x->sm.sm_mode = (short)smm_synonym;
  1885.     x->sm.sm_fp = NULL;
  1886.     x->sm.sm_object0 = Vterminal_io;
  1887.     x->sm.sm_object1 = OBJNULL;
  1888.     x->sm.sm_int0 = x->sm.sm_int1 = 0;
  1889.     standard = x;
  1890.  
  1891.     Vstandard_input
  1892.     = make_special("*STANDARD-INPUT*", standard);
  1893.     Vstandard_output
  1894.     = make_special("*STANDARD-OUTPUT*", standard);
  1895.     Verror_output
  1896.     = make_special("*ERROR-OUTPUT*", standard);
  1897.  
  1898. #ifdef AOSVS1
  1899.  
  1900.  
  1901.  
  1902.  
  1903.  
  1904.  
  1905.  
  1906.  
  1907.  
  1908.  
  1909.  
  1910.  
  1911.  
  1912.  
  1913. #endif
  1914.  
  1915.     Vquery_io
  1916.     = make_special("*QUERY-IO*", standard);
  1917.     Vdebug_io
  1918.     = make_special("*DEBUG-IO*", standard);
  1919.     Vtrace_output
  1920.     = make_special("*TRACE-OUTPUT*", standard);
  1921.  
  1922. #ifdef AOSVS1
  1923.  
  1924.  
  1925.  
  1926.  
  1927.  
  1928.  
  1929.  
  1930.  
  1931.  
  1932.  
  1933.  
  1934.  
  1935.  
  1936.  
  1937.  
  1938.  
  1939.  
  1940.  
  1941.  
  1942. #endif
  1943. }
  1944.  
  1945. init_file_function()
  1946. {
  1947.     Kabort = make_keyword("ABORT");
  1948.  
  1949.     Kdirection = make_keyword("DIRECTION");
  1950.     Kinput = make_keyword("INPUT");
  1951.     Koutput = make_keyword("OUTPUT");
  1952.     Kio = make_keyword("IO");
  1953.     Kprobe = make_keyword("PROBE");
  1954.     Kelement_type = make_keyword("ELEMENT-TYPE");
  1955.     Kdefault = make_keyword("DEFAULT");
  1956.     Kif_exists = make_keyword("IF-EXISTS");
  1957.     Kerror = make_keyword("ERROR");
  1958.     Knew_version = make_keyword("NEW-VERSION");
  1959.     Krename = make_keyword("RENAME");
  1960.     Krename_and_delete = make_keyword("RENAME-AND-DELETE");
  1961.     Koverwrite = make_keyword("OVERWRITE");
  1962.     Kappend = make_keyword("APPEND");
  1963.     Ksupersede = make_keyword("SUPERSEDE");
  1964.     Kif_does_not_exist = make_keyword("IF-DOES-NOT-EXIST");
  1965.     /*  Kerror = make_keyword("ERROR");  */
  1966.     Kcreate = make_keyword("CREATE");
  1967.  
  1968.     Kprint = make_keyword("PRINT");
  1969.     Kverbose = make_keyword("VERBOSE");
  1970.     Kif_does_not_exist = make_keyword("IF-DOES-NOT-EXIST");
  1971.     Kset_default_pathname = make_keyword("SET-DEFAULT-PATHNAME");
  1972.  
  1973.     Vload_verbose = make_special("*LOAD-VERBOSE*", Ct);
  1974.     siVload_pathname = make_si_special("*LOAD-PATHNAME*",Cnil);
  1975.  
  1976. #ifdef UNIX
  1977.     FASL_string = make_simple_string("o");
  1978.     make_si_constant("*EOF*",make_fixnum(EOF));
  1979. #endif
  1980. #ifdef AOSVS
  1981.  
  1982. #endif
  1983.     enter_mark_origin(&FASL_string);
  1984. #ifdef UNIX
  1985.     LSP_string = make_simple_string("lsp");
  1986. #endif
  1987. #ifdef AOSVS
  1988.  
  1989. #endif
  1990.     enter_mark_origin(&LSP_string);
  1991.     make_si_function("FP-INPUT-STREAM",    siLfp_input_stream);
  1992.     make_si_function("FP-OUTPUT-STREAM",    siLfp_output_stream);
  1993.  
  1994.     make_function("MAKE-SYNONYM-STREAM", Lmake_synonym_stream);
  1995.     make_function("MAKE-BROADCAST-STREAM", Lmake_broadcast_stream);
  1996.     make_function("MAKE-CONCATENATED-STREAM",
  1997.               Lmake_concatenated_stream);
  1998.     make_function("MAKE-TWO-WAY-STREAM", Lmake_two_way_stream);
  1999.     make_function("MAKE-ECHO-STREAM", Lmake_echo_stream);
  2000.     make_function("MAKE-STRING-INPUT-STREAM",
  2001.               Lmake_string_input_stream);
  2002.     make_function("MAKE-STRING-OUTPUT-STREAM",
  2003.               Lmake_string_output_stream);
  2004.     make_function("GET-OUTPUT-STREAM-STRING",
  2005.               Lget_output_stream_string);
  2006.  
  2007.     make_si_function("OUTPUT-STREAM-STRING", siLoutput_stream_string);
  2008.     make_si_function("FWRITE",Lfwrite);
  2009.     make_si_function("FREAD",Lfread);
  2010.     make_function("STREAMP", Lstreamp);
  2011.     make_function("INPUT-STREAM-P", Linput_stream_p);
  2012.     make_function("OUTPUT-STREAM-P", Loutput_stream_p);
  2013.     make_function("STREAM-ELEMENT-TYPE", Lstream_element_type);
  2014.     make_function("CLOSE", Lclose);
  2015.  
  2016.     make_function("OPEN", Lopen);
  2017.  
  2018.     make_function("FILE-POSITION", Lfile_position);
  2019.     make_function("FILE-LENGTH", Lfile_length);
  2020.  
  2021.     make_function("LOAD", Lload);
  2022.  
  2023.     make_si_function("GET-STRING-INPUT-STREAM-INDEX",
  2024.              siLget_string_input_stream_index);
  2025.     make_si_function("MAKE-STRING-OUTPUT-STREAM-FROM-STRING",
  2026.              siLmake_string_output_stream_from_string);
  2027.     make_si_function("COPY-STREAM", siLcopy_stream);
  2028.  
  2029. #ifdef USER_DEFINED_STREAMS
  2030.     make_si_function("USER-STREAM-STATE", siLuser_stream_state);
  2031. #endif
  2032.     siVignore_eof_on_terminal_io
  2033.     = make_si_special("*IGNORE-EOF-ON-TERMINAL-IO*", Cnil);
  2034. }
  2035.  
  2036.  
  2037. object
  2038. read_fasl_data(str)
  2039. char *str;
  2040. {
  2041.     object faslfile, data;
  2042. #ifdef UNIX
  2043.     FILE *fp;
  2044. #ifdef BSD
  2045.     struct exec header;
  2046. #endif
  2047. #ifdef ATT
  2048.     struct filehdr fileheader;
  2049. #endif
  2050. #ifdef E15
  2051.     struct exec header;
  2052. #endif
  2053.     int i;
  2054. #endif
  2055.         vs_mark;
  2056.  
  2057.     faslfile = make_simple_string(str);
  2058.     vs_push(faslfile);
  2059.     faslfile = open_stream(faslfile, smm_input, Cnil, Kerror);
  2060.     vs_push(faslfile);
  2061.  
  2062. #ifdef SEEK_TO_END_OFILE
  2063.      SEEK_TO_END_OFILE(faslfile->sm.sm_fp);
  2064. #else
  2065.  
  2066. #ifdef BSD
  2067.     fp = faslfile->sm.sm_fp;
  2068.     fread(&header, sizeof(header), 1, fp);
  2069.     fseek(fp,
  2070.           header.a_text+header.a_data+
  2071.           header.a_syms+header.a_trsize+header.a_drsize,
  2072.           1);
  2073.     fread(&i, sizeof(i), 1, fp);
  2074.     fseek(fp, i - sizeof(i), 1);
  2075. #endif
  2076.  
  2077. #ifdef ATT
  2078.     fp = faslfile->sm.sm_fp;
  2079.     fread(&fileheader, sizeof(fileheader), 1, fp);
  2080.     fseek(fp,
  2081.           fileheader.f_symptr+fileheader.f_nsyms*SYMESZ,
  2082.           0);
  2083.     fread(&i, sizeof(i), 1, fp);
  2084.     fseek(fp, i - sizeof(i), 1);
  2085.     while ((i = getc(fp)) == 0)
  2086.         ;
  2087.     ungetc(i, fp);
  2088. #endif
  2089.  
  2090. #ifdef E15
  2091.     fp = faslfile->sm.sm_fp;
  2092.     fread(&header, sizeof(header), 1, fp);
  2093.     fseek(fp,
  2094.           header.a_text+header.a_data+
  2095.           header.a_syms+header.a_trsize+header.a_drsize,
  2096.           1);
  2097. #endif
  2098.  
  2099. #ifdef DGUX
  2100.  
  2101.  
  2102.  
  2103.  
  2104. #endif
  2105.  
  2106. #ifdef AOSVS
  2107.  
  2108.  
  2109.  
  2110.  
  2111. #endif
  2112. #endif
  2113.     data = read_fasl_vector(faslfile);
  2114.  
  2115.     vs_push(data);
  2116.     close_stream(faslfile, TRUE);
  2117.     vs_reset;
  2118.     return(data);
  2119. }
  2120.